(in-package #:experiment)

(defstruct volume-level
  data min max mean median)

(defun median (data)
  (let ((l (sort (copy-list data) '<)))
    (if (evenp (length l))
        (/ (+ (elt l (truncate (length l) 2))
              (elt l (1- (truncate (length l) 2))))
           2)
        (elt l (truncate (length l) 2)))))

(defun sorted-elt (data n)
  (let ((l (sort (copy-list data) '<)))
    (elt l n)))

(defun analyze-volume-data (data)
  (loop for v in data
        maximize v into max
        minimize v into min
        sum v into sum
        finally (return (make-volume-level :data (copy-list data)
                                           :min min
                                           :max max
                                           :mean (/ sum (length data))
                                           :median (median data)))))

(defvar *speech-juice-silence* nil)
(defvar *speech-juice-sound* nil)

(gwee:define-component speech-juice-calibration (state)
    ((fsm :initform :start)
     (accum-duration :initform nil)
     (accum :initform nil))
    (:views
     (message gwee:text-area
              :width :maximum
              :height :maximum
              :horizontal-justification :center
              :vertical-justification :center
              :font (gwee:open-font "sans.ttf" 18)
              :parent state
              :data "Press ENTER to begin calibrating the microphone."))
    (:layouts
     (default gwee:view
              (message))))

(defun find-audio-record ()
  (find-if (lambda (s) (typep s 'audio-record)) (state-stack *experiment*)))

(defun sjc-set-volume-hook (state duration)
  (let ((audio-record (find-audio-record)))
    (setf (volume-hook audio-record) (lambda (v)
                                       (sjc-accum-volume state v))
          (slot-value state 'accum-duration) duration)))

(defun sjc-clear-volume-hook ()
  (let ((audio-record (find-audio-record)))
    (setf (volume-hook audio-record) nil)))

(defun sjc-accum-volume (state vol)
  (with-slots (accum accum-duration) state
    (push vol accum)
    (when (> (length accum) accum-duration)
      (setf accum (nreverse accum))
      (sjc-advance state))))

(defun sjc-advance (state)
  (with-slots (fsm accum message) state
    (case fsm
      (:start
       (setf fsm :silence
             (gwee:view-data message) "Please remain silent for the next few seconds."
             (gwee:view-needs-update-p message) t
             accum nil)
       (sjc-set-volume-hook state 10))
      (:silence
       (setf *speech-juice-silence* (analyze-volume-data (cdr accum))
             fsm :post-silence
             (gwee:view-data message) "Thank you! Now press ENTER and read the following paragraph aloud in a normal voice."
             (gwee:view-needs-update-p message) t)
       (sjc-clear-volume-hook))
      (:post-silence
       (setf (gwee:view-data message) (list "Of Mans First Disobedience, and the Fruit"
                                            "Of that Forbidden Tree, whose mortal tast"
                                            "Brought Death into the World, and all our woe,"
                                            "With loss of EDEN, till one greater Man"
                                            "Restore us, and regain the blissful Seat,"
                                            "Sing Heav'nly Muse, that on the secret top"
                                            "Of OREB, or of SINAI, didst inspire"
                                            "That Shepherd, who first taught the chosen Seed,"
                                            "In the Beginning how the Heav'ns and Earth"
                                            "Rose out of CHAOS: Or if SION Hill"
                                            "Delight thee more, and SILOA'S Brook that flow'd"
                                            "Fast by the Oracle of God; I thence"
                                            "Invoke thy aid to my adventrous Song,"
                                            "That with no middle flight intends to soar"
                                            "Above th' AONIAN Mount, while it pursues"
                                            "Things unattempted yet in Prose or Rhime."
                                            "And chiefly Thou O Spirit, that dost prefer"
                                            "Before all Temples th' upright heart and pure,"
                                            "Instruct me, for Thou know'st; Thou from the first"
                                            "Wast present, and with mighty wings outspread"
                                            "Dove-like satst brooding on the vast Abyss"
                                            "And mad'st it pregnant: What in me is dark"
                                            "Illumine, what is low raise and support;"
                                            "That to the highth of this great Argument"
                                            "I may assert th' Eternal Providence,"
                                            "And justifie the wayes of God to men.")
             (gwee:view-needs-update-p message) t
             fsm :speech
             accum nil)
       (sjc-set-volume-hook state 25))
      (:speech
       (setf fsm :done
             *speech-juice-sound* (analyze-volume-data accum ;; (cdddr accum)
                                                       )
             (gwee:view-data message) (list "Good enough! Your microphone has been calibrated." "" "Press ENTER to continue")
             (gwee:view-needs-update-p message) t)
       (sjc-clear-volume-hook))
      (:done
       (state-onward *experiment* state)))))

(define-action press-enter ((state speech-juice-calibration)
                            (keypress :char #\Return))
  (with-slots (fsm) state
    (when (find fsm '(:start :post-silence :done))
      (sjc-advance state))))

(defmethod state-init (exp (state speech-juice-calibration))
  (declare (ignore exp))
  )

(defmethod state-end (exp (state speech-juice-calibration))
  (declare (ignore exp))
  (lg 'end
      :silence-data (volume-level-data *speech-juice-silence*)
      :sound-data (volume-level-data *speech-juice-sound*)))

(defclass speech-juice (gwee:view gwee:background-mixin gwee:animation-mixin)
  ((juice :initform 0.4 :initarg :initial-juice :accessor juice)
   (talkingp :initform nil :accessor talkingp)
   (audio-record))
  (:default-initargs
   :update-callback #'animate-speech-juice
   :fps 10
   :width 20
   :height :maximum
   :border-color (gwee:gray 0)))

(defmethod gwee:draw-view ((view speech-juice))
  (let* ((height (truncate (* (juice view) (gwee:view-height view))))
         (start (- (gwee:view-height view) height))
         (flash-color (when (and (< (juice view) 0.2)
                                 (not (talkingp view)))
                        (if (evenp (truncate (get-internal-real-time) 300))
                            (gwee:color 255 0 0)
                            (gwee:gray 255))))
         (color (cond
                  ((> (juice view) 0.5)
                   (gwee:color 0 255 0))
                  ((> (juice view) 0.2)
                   (gwee:color 255 128 0))
                  (t
                   (gwee:color 255 0 0)))))
    (if flash-color
        (gwee:draw-rectangle view 0 0
                             (gwee:view-width view)
                             (gwee:view-height view)
                             :color flash-color
                             :filled t)
        (gwee:draw-rectangle view 0 start
                             (gwee:view-width view)
                             height
                             :color color
                             :filled t))))

(defun setup-speech-juice (sj)
  (with-slots (audio-record) sj
    (setf audio-record (find-if (lambda (s) (typep s 'audio-record)) (state-stack *experiment*)))
    (when audio-record
      (setf (volume-hook audio-record) (lambda (v)
                                         (speech-juice-update sj v))))))

(defun speech-juice-update (sj volume)
  (setf (talkingp sj) (> volume (* (volume-level-mean *speech-juice-sound*) 0.3))))

(defmethod animate-speech-juice (sj)
  (if (talkingp sj)
      (incf (juice sj) 0.01)
      (decf (juice sj) 0.005))
  (setf (juice sj) (max (min (juice sj) 1.0) 0)))
